home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MATH.SWG / 0048_Math Evaluations.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-21  |  9KB  |  347 lines
  1. {
  2. From: WARREN PORTER
  3. Subj: eval
  4. Program to evaluate expressions using a stack. }
  5.  
  6. const
  7.   Maxstack = 100;
  8.  
  9. type
  10.  
  11.   stack = record
  12.         top : 0..Maxstack;
  13.         Item : array[1..Maxstack] of char
  14.         end;
  15.  
  16.   RealStack = record
  17.         top: 0..Maxstack;
  18.         Item : array[1..Maxstack] of real
  19.         end;
  20.  
  21.   xptype = record
  22.         oper : char;
  23.         opnd : real
  24.         end;
  25.  
  26. Function Empty(var A:stack):boolean;
  27.  
  28. Begin
  29.   Empty:= A.top = 0;
  30. End;
  31.  
  32. Function Pop(var A:stack):char;
  33.  
  34. Begin
  35.   if A.Top < 1 then
  36.     begin
  37.       writeln('Attempt to pop an empty stack');
  38.       halt(1)
  39.     end;
  40.   Pop:= A.item[A.top];
  41.   A.top:= A.top - 1
  42. End;
  43.  
  44. Procedure Push(var A:stack; Nchar:char);
  45.  
  46. Begin
  47.   if A.Top = Maxstack then
  48.     begin
  49.       writeln('Stack already full');
  50.       halt(1)
  51.     end;
  52.   A.top:= A.top + 1;
  53.   A.item[A.top]:=Nchar
  54. End;
  55.  
  56.      {The following functions are for the real stack only.}
  57.  
  58. Function REmpty(var D:RealStack):boolean;
  59.  
  60. Begin
  61.   REmpty:= D.top = 0;
  62. End;
  63.  
  64. Function RPop(var D:RealStack):real;
  65.  
  66. Begin
  67.   if D.Top < 1 then
  68.     begin
  69.       writeln('Attempt to pop an empty RealStack');
  70.       halt(1)
  71.     end;
  72.   RPop:= D.item[D.top];
  73.   D.top:= D.top - 1
  74. End;
  75.  
  76. Procedure RPush(var D:RealStack; Nreal:real);
  77.  
  78. Begin
  79.   if D.Top = MaxStack then
  80.     begin
  81.       writeln('Stack already full');
  82.       halt(1)
  83.     end;
  84.   D.top:= D.top + 1;
  85.   D.item[D.top]:=Nreal
  86. End;
  87.  
  88. Function pri(op1, op2:char):boolean;
  89.  
  90. var
  91.   tpri: boolean;
  92. Begin
  93.   if op2 = ')' then
  94.     tpri:= true                            else
  95.   if (op1 = '$') and (op2 <> '$') and (op2 <> '(')  then
  96.     tpri:= true                            else
  97.   if (op1 in ['*','/']) and (op2 in ['+','-']) then
  98.     tpri:= true
  99.   else
  100.     tpri:= false;
  101.   pri:= tpri{;
  102.   write('Eval op 1= ',op1, ' op2 = ',op2);
  103.   if tpri= false then
  104.      writeln(' false')
  105.   else
  106.      writeln(' true')}
  107. End;
  108.  
  109. Function ConvReal(a:real;NumDec:integer):real;
  110.  
  111. var
  112.    i, tenpower: integer;
  113.  
  114. Begin
  115.    tenpower:= 1;
  116.    for i:= 1 to NumDec do
  117.       tenpower:= tenpower * 10;
  118.    ConvReal:= a / tenpower
  119. End;
  120.  
  121. Function ROper(opnd1, opnd2: real; oper: char):real;
  122. Var temp: real;
  123.  
  124. Begin
  125.    Case oper of
  126.       '+': temp:= opnd1 + opnd2;
  127.       '-': temp:= opnd1 - opnd2;
  128.       '*': temp:= opnd1 * opnd2;
  129.       '/': temp:= opnd1 / opnd2;
  130.       '$': temp:= exp(ln(opnd1) * opnd2)
  131.    End {Case}     ;
  132.    {Writeln(opnd1:6:3,' ',oper,' ',opnd2:6:3 ,' = ',temp:6:3);}
  133.    ROper := temp
  134. End; {R oper}
  135.  
  136. {Main procedure starts here}
  137.  
  138. var
  139.   A: stack;
  140.   Inbuff:string[Maxstack];
  141.   len, i, j, NumDecPnt, lenexp: integer;
  142.   temp, opnd1, opnd2, result : real;
  143.   valid, expdigit, expdec, isneg, openok: boolean;
  144.   operators, digits : set of char;
  145.   HoldTop : char;
  146.   B: array[1..Maxstack] of xptype;
  147.   C: array[1..Maxstack] of xptype;
  148.   D: RealStack;
  149.  
  150. Begin
  151.   digits:= ['0'..'9'];
  152.   operators:= ['$','*','/','+','-','(',')'];
  153.   Writeln('Enter expression to evaluate or RETURN to stop');
  154.   Writeln('A space should follow a minus sign unless it is used to');
  155.   Writeln('negate the following number.  Real numbers with multi-');
  156.   Writeln('digits and decimal point (if needed) may be entered.');
  157.   Writeln;
  158.   Readln(Inbuff);
  159.   len:=length(Inbuff);
  160.  
  161.   repeat
  162.     i:= 1;
  163.     A.top:= 0;
  164.     valid:= true;
  165.     repeat
  166.       if Inbuff[i] in ['(','[','{'] then
  167.         push(A,Inbuff[i])
  168.       else
  169.         if Inbuff[i] in [')',']','}'] then
  170.           if empty(A) then
  171.             valid:= false
  172.           else
  173.             if (ord(Inbuff[i]) - ord(Pop(A))) > 2 then
  174.               valid:= false;
  175.       i:= i + 1
  176.     until (i > len) or (not valid);
  177.     if not empty(A) then
  178.       valid:= false;
  179.     if not valid then
  180.       Writeln('The expression is invalid')
  181.     else
  182.       Begin
  183.          {Change all groupings to parenthesis}
  184.          for i:= 1 to len do Begin
  185.            if Inbuff[i] in ['[','{'] then
  186.               Inbuff[i]:= '('  else
  187.            if Inbuff[i] in [']','}'] then
  188.               Inbuff[i]:= ')';
  189.            B[i].oper:= ' ';
  190.            B[i].opnd:= 0;
  191.            C[i].oper:= ' ';
  192.            C[i].opnd:= 0    End;
  193.  
  194.          { The B array will be the reformatted input string.
  195.            The C array will be the postfix expression. }
  196.  
  197.          i:= 1; j:= 1; expdigit:= false; expdec:= false; isneg:= false;
  198.          while i <= len do
  199.             Begin
  200.                if (Inbuff[i] = '-') and (Inbuff[i + 1] in digits) then
  201.                   Begin
  202.                      isneg:= true;
  203.                      i:= i + 1
  204.                   End;
  205.                if (Inbuff[i] = '.' ) then  Begin
  206.                   i:= i + 1;
  207.                   expdec:= true            End;
  208.                if Inbuff[i] in digits then
  209.                   Begin
  210.                      if expdec then
  211.                         NumDecPnt:= NumDecPnt + 1;
  212.                      if expdigit then
  213.                         temp:= temp * 10 + ord(inbuff[i]) - ord('0')
  214.                      else                  Begin
  215.                         temp:= ord(inbuff[i]) - ord('0');
  216.                         expdigit:= true    End
  217.                   End
  218.                else
  219.                   if expdigit = true then    Begin
  220.                      if isneg then
  221.                         temp:= temp * -1;
  222.                      B[j].opnd:= ConvReal(temp,NumDecPnt);
  223.                      j:= j + 1;
  224.                      expdigit := false;
  225.                      expdec   := false;
  226.                      NumDecPnt:= 0;
  227.                      isneg:= false           End;
  228.  
  229.                If Inbuff[i] in operators     then Begin
  230.                   B[j].oper:= Inbuff[i];
  231.                   j:= j + 1                       End;
  232.  
  233.                if not (Inbuff[i] in digits)    and
  234.                   not (Inbuff[i] in operators) and
  235.                   not (Inbuff[i] = ' ') then                Begin
  236.                   Writeln('Found invalid operator: ',Inbuff[i]);
  237.                   valid:= false                             End;
  238.  
  239.                i:= i + 1;
  240.  
  241.             End;  {While loop to parse string.}
  242.  
  243.             if expdigit = true then    Begin
  244.                if isneg then
  245.                   temp:= temp * -1;
  246.                B[j].opnd:= ConvReal(temp,NumDecPnt);
  247.                j:= j + 1;
  248.                expdigit := false;
  249.                expdec   := false;
  250.                NumDecPnt:= 0;
  251.                isneg:= false           End;
  252.  
  253.       End; {First if valid loop.  Next one won't run if invalid operator}
  254.  
  255.     if valid then
  256.       Begin
  257.          lenexp:= j - 1;    {Length of converted expression}
  258.          writeln;
  259.          for i:= 1 to lenexp do
  260.             Begin
  261.                if B[i].oper = ' ' then
  262.                   write(B[i].opnd:2:3)
  263.                else
  264.                   write(B[i].oper);
  265.                write(' ')
  266.             End;
  267.  
  268.          {Ready to create postfix expression in array C }
  269.  
  270.          A.top:= 0;
  271.          j:= 0;
  272.  
  273.          for i:= 1 to lenexp do
  274.             Begin
  275.                {writeln('i = ',i);}
  276.                if B[i].oper = ' ' then       Begin
  277.                   j:= j + 1;
  278.                   C[j].opnd:= B[i].opnd      End
  279.                else
  280.                   Begin
  281.                   openok := true;
  282.                      while (not empty(A) and openok and
  283.                            pri(A.item[A.top],B[i].oper)) do
  284.                         Begin
  285.                            HoldTop:= pop(A);
  286.                            if HoldTop = '(' then
  287.                               openok:= false
  288.                            else
  289.                               Begin
  290.                                  j:= j + 1;
  291.                                  C[j].oper:=HoldTop
  292.                               End
  293.                         End;
  294.                      if B[i].oper <> ')' then
  295.                         push(A,B[i].oper);
  296.                   End; {Else}
  297.             End; {For loop}
  298.  
  299.             while not empty(A) do
  300.                Begin
  301.                   HoldTop:= pop(A);
  302.                   if HoldTop <> '(' then
  303.                      Begin
  304.                         j:= j + 1;
  305.                         C[j].oper:=HoldTop
  306.                      End
  307.                End;
  308.  
  309.          lenexp:= j;  {Since parenthesis are not included in postfix.}
  310.  
  311.          for i:= 1 to lenexp do
  312.             Begin
  313.                if C[i].oper = ' ' then
  314.                   write(C[i].opnd:2:3)
  315.                else
  316.                   write(C[i].oper);
  317.                write(' ')
  318.             End;
  319.  
  320.          {The following evaluates the expression in the real stack}
  321.  
  322.          D.top:=0;
  323.          for i:= 1 to lenexp do
  324.             Begin
  325.                if C[i].oper = ' ' then
  326.                   Rpush(D,C[i].opnd)
  327.                else
  328.                   Begin
  329.                      opnd2:= Rpop(D);
  330.                      opnd1:= Rpop(D);
  331.                      result:= ROper(opnd1,opnd2,C[i].oper);
  332.                      Rpush(D,result)
  333.                   End {else}
  334.             End; {for loop}
  335.          result:= Rpop(D);
  336.          if Rempty(D) then
  337.             writeln('    = ',result:2:3)
  338.          else
  339.             writeln('    Could not evaluate',chr(7))
  340.       End;
  341.  
  342.     Readln(Inbuff);
  343.     len:= length(Inbuff)
  344.   until len = 0
  345. End.
  346.  
  347.